(in-package #:org.shirakumo.fraf.trial.glfw)

(define-global +none+ (make-symbol "NONE"))
(declaim (inline push-event-queue request-event-queue))

(defstruct (request
            (:constructor make-request (&optional type arg await)))
  (type +none+ :type symbol)
  (arg NIL :type T)
  (await NIL :type boolean))

(defun make-event-queue ()
  (let ((queue (make-array 128)))
    (dotimes (i (length queue) queue)
      (setf (svref queue i) (make-request)))))

(defun handle-event-queue (queue handler)
  (declare (type (simple-vector 128) queue))
  (loop for i from 0 below 128
        for cell = (the request (aref queue i))
        do (when (and (not (eq (request-type cell) +none+))
                      (not (eq (request-type cell) T))
                      (not (eq (request-arg cell) +none+)))
             (let ((ret (funcall handler (request-type cell) (request-arg cell))))
               (cond ((request-await cell)
                      (setf (request-arg cell) ret)
                      (setf (request-type cell) T))
                     (T
                      (setf (request-arg cell) +none+)
                      (setf (request-type cell) +none+)))))))

(defun push-event-queue (queue request &optional arg await)
  (declare (type (simple-vector 128) queue))
  (check-type request keyword)
  (loop for i of-type (unsigned-byte 8) = 0 then (1+ i)
        for cell = (the request (svref queue i))
        do (when (eq (request-type cell) +none+)
             (when (atomics:cas (request-type cell) +none+ request)
               (setf (request-arg cell) arg)
               (setf (request-await cell) await)
               (return i)))
           (when (<= 127 i)
             (v:warn :trial.backend.glfw "Failed to queue event, dropping ~a ~a" request arg)
             (return -1))))

(defun await-event-queue (queue i)
  (declare (type (simple-vector 128) queue))
  (declare (type (integer 0 127) i))
  (loop for cell = (the request (svref queue i))
        do (cond ((eq (request-arg cell) +none+)
                  (return NIL))
                 ((eq (request-arg cell) T)
                  (let ((result (shiftf (request-arg cell) +none+)))
                    (setf (request-type cell) +none+)
                    (return result)))
                 (T
                  (sleep 0.0001)))))

(defun request-event-queue (queue request &optional arg)
  (let ((i (push-event-queue queue request arg T)))
    (when (<= 0 i)
      (await-event-queue queue i))))
